Information on the data can be found at this link.

# The data must be downloaded and unzipped, there are multiple files in the zip which are needed
directory_to_use <- "data/"
download.file("https://opendata.arcgis.com/datasets/d9be85b30d7748b5b7c09450b8aede63_0.zip?outSR=%7B%22latestWkid%22%3A3857%2C%22wkid%22%3A102100%7D",
              file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.zip"))
utils::unzip(file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.zip"), 
             exdir = directory_to_use)
covid_openddata_shpdata <-  rgdal::readOGR(dsn = file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.shp"), stringsAsFactors = F)
## OGR data source with driver: ESRI Shapefile 
## Source: "/Users/aidanboland/Git/TutoR/Code_Walkthrough/COVID/data/Covid19CountyStatisticsHPSCIreland.shp", layer: "Covid19CountyStatisticsHPSCIreland"
## with 5000 features
## It has 16 fields
# Create data frame containing the polygon coordinates
county_polygon_data <- broom::tidy(covid_openddata_shpdata, region = "CountyName")
# write.csv(county_polygon_data, file = file.path(directory_to_use, "county_polygon.csv"), row.names = F) # Optional save county polygon data
# county_polygon_data <- readr::read_csv(county_polygon_data, file = "data/county_polygon.csv")
# Create data frame of the covid stats only, no spatial data
raw_covid_stats <- 
  covid_openddata_shpdata@data  %>%
  rename(PopulationCensus16 = Population, ConfirmedCovidCases = ConfirmedC)

# A more up to date dataset (without spatial data)
raw_covid_stats <- 
  readr::read_csv("http://opendata-geohive.hub.arcgis.com/datasets/d9be85b30d7748b5b7c09450b8aede63_0.csv?outSR={%22latestWkid%22:3857,%22wkid%22:102100}")
covid_rolling14 <- 
  raw_covid_stats %>%
  # Remove unneeded columns and parse date
  select(CountyName, TimeStamp, PopulationCensus16, ConfirmedCovidCases) %>%
  mutate(TimeStamp = as.Date(TimeStamp)) %>%
  
  # Add any missing dates and fill the data for missing dates
  group_by(CountyName) %>%
  tidyr::complete(TimeStamp = seq(min(as.Date(.$TimeStamp)), # use .$TimeStamp to get global data min 
                                  max(as.Date(.$TimeStamp)), # not just the min for the group_by var
                                  by = "day")) %>%
  # Ensure the data is arranged by date
  arrange(TimeStamp) %>%
  tidyr::fill(PopulationCensus16, ConfirmedCovidCases, .direction = "down") %>%
  
  # Calculate the lag and then the cases per day
  mutate(lag_cases = lag(ConfirmedCovidCases, 1, default = 0),
         new_cases = ConfirmedCovidCases - lag_cases,
         new_cases_per100 = 100000 * (new_cases/PopulationCensus16),
         
         # Rolling 14 Day Total
         rolling14 = rollsum(new_cases, 14, align = "right", fill = 0),
         rolling14_per100 = rollsum(new_cases_per100, 14, align = "right", fill = 0)) %>%
  ungroup()

Animation

# Animation
rolling14_anim <- 
  covid_rolling14 %>%
  # Filter the data by date
  filter(TimeStamp >= "2020-08-01") %>% # Sys.Date() - 50
  # Join data to county map data
  full_join(county_polygon_data, by = c("CountyName" = "id")) %>%
  ggplot() + geom_polygon(aes(x = long, y = lat, group = group, fill = rolling14_per100), colour = "black") + 
  theme_void() +
  theme(text = element_text(size = 14)) +
  scale_fill_distiller(palette = "RdYlGn",
                       # limits = c(0, max(covid_rolling14$rolling14_per100))
                       ) +
  coord_quickmap() +
  # -Animation-
  # Plot elements for animation
  transition_time(TimeStamp) +
  labs(title = "COVID Rolling 14 Day Cases Per 100,000",
       subtitle = 'Up to {format(frame_time, "%B %d")}', 
       fill = "Cases per 100k")

# Create the animation, nframes and fps will set the speed of the animation
# This can be slow depending on choices
map_anim <- 
  animate(rolling14_anim, 
          nframes = 120, fps = 10,
          start_pause = 5, end_pause = 20)

anim_save(filename = paste0(directory_to_use, "rolling_14day2_", Sys.Date(),".gif"),
          animation = map_anim)

Testing Data

testing_csv <- 
  readr::read_csv("http://opendata-geohive.hub.arcgis.com/datasets/f6d6332820ca466999dbd852f6ad4d5a_0.csv?outSR={%22latestWkid%22:3857,%22wkid%22:102100}")
testing_csv$Date_HPSC <- as.Date(testing_csv$Date_HPSC)


testing_tidy <- 
  testing_csv %>%
  arrange(Date_HPSC) %>%
  mutate(lag_labs = lag(TotalLabs),
         lag_positive = lag(Positive),
         daily_labs = TotalLabs - lag_labs,
         daily_positive = Positive - lag_positive,
         rolling14_labs = rollsum(daily_labs, 14, align = "right", fill = 0),
         rolling14_positive = rollsum(daily_positive, 14, align = "right", fill = 0),
         roling14_percentage = 100*(rolling14_positive/rolling14_labs)) %>%
  select(Date_HPSC, Tests = rolling14_labs, 
         `Positive Tests` = rolling14_positive, 
         `Percentage Positive` = roling14_percentage) %>%
  tidyr::pivot_longer(cols = c(Tests, `Positive Tests`, `Percentage Positive`), names_to = "stat", values_to = "rolling14") %>%
  mutate(stat = factor(stat, levels = c("Tests", "Positive Tests", "Percentage Positive")))
  
testing_14_anim <- 
  testing_tidy %>%  
  filter(Date_HPSC >= "2020-08-01") %>%
  ggplot(aes(x = Date_HPSC, y = rolling14), colour = "black") +
  geom_line() +
  geom_point() +
  facet_wrap(~stat, ncol = 1, scales = "free", ) +
  labs(x = "Date", y = "",
       title = "Totals for Previous 14 Days") +
  theme_light() +
  theme(text = element_text(size = 16),
        strip.text.x = element_text(size = 20)) +
  transition_reveal(Date_HPSC)


test_anim <- 
  animate(testing_14_anim,
        nframes = 120, fps = 10,
          start_pause = 5, end_pause = 20)

anim_save(filename = paste0(directory_to_use, "rolling_14day_tests_", Sys.Date(),".gif"),
          test_anim = map_anim)
library(magick)

map_anim2 <- 
  animate(rolling14_anim, 
          nframes = 120, fps = 10,
          start_pause = 5, end_pause = 20,
          renderer = magick_renderer())

test_anim2 <- 
  animate(testing_14_anim,
        nframes = 120, fps = 10,
          start_pause = 5, end_pause = 20, 
        renderer = magick_renderer())

new_gif <- image_append(c(map_anim2[1], test_anim2[1]))
for(i in 2:120){
  combined <- image_append(c(map_anim2[i], test_anim2[i]))
  new_gif <- c(new_gif, combined)
}

new_gif

magick::image_write_gif(new_gif, 
                        path = paste0(directory_to_use, "rolling_14day_combined2_", Sys.Date(),".gif"),
                        delay = 1/10)
## 
Frame 1 (0%)
Frame 2 (1%)
Frame 3 (2%)
Frame 4 (3%)
Frame 5 (4%)
Frame 6 (5%)
Frame 7 (5%)
Frame 8 (6%)
Frame 9 (7%)
Frame 10 (8%)
Frame 11 (9%)
Frame 12 (10%)
Frame 13 (10%)
Frame 14 (11%)
Frame 15 (12%)
Frame 16 (13%)
Frame 17 (14%)
Frame 18 (15%)
Frame 19 (15%)
Frame 20 (16%)
Frame 21 (17%)
Frame 22 (18%)
Frame 23 (19%)
Frame 24 (20%)
Frame 25 (20%)
Frame 26 (21%)
Frame 27 (22%)
Frame 28 (23%)
Frame 29 (24%)
Frame 30 (25%)
Frame 31 (25%)
Frame 32 (26%)
Frame 33 (27%)
Frame 34 (28%)
Frame 35 (29%)
Frame 36 (30%)
Frame 37 (30%)
Frame 38 (31%)
Frame 39 (32%)
Frame 40 (33%)
Frame 41 (34%)
Frame 42 (35%)
Frame 43 (35%)
Frame 44 (36%)
Frame 45 (37%)
Frame 46 (38%)
Frame 47 (39%)
Frame 48 (40%)
Frame 49 (40%)
Frame 50 (41%)
Frame 51 (42%)
Frame 52 (43%)
Frame 53 (44%)
Frame 54 (45%)
Frame 55 (45%)
Frame 56 (46%)
Frame 57 (47%)
Frame 58 (48%)
Frame 59 (49%)
Frame 60 (50%)
Frame 61 (50%)
Frame 62 (51%)
Frame 63 (52%)
Frame 64 (53%)
Frame 65 (54%)
Frame 66 (55%)
Frame 67 (55%)
Frame 68 (56%)
Frame 69 (57%)
Frame 70 (58%)
Frame 71 (59%)
Frame 72 (60%)
Frame 73 (60%)
Frame 74 (61%)
Frame 75 (62%)
Frame 76 (63%)
Frame 77 (64%)
Frame 78 (65%)
Frame 79 (65%)
Frame 80 (66%)
Frame 81 (67%)
Frame 82 (68%)
Frame 83 (69%)
Frame 84 (70%)
Frame 85 (70%)
Frame 86 (71%)
Frame 87 (72%)
Frame 88 (73%)
Frame 89 (74%)
Frame 90 (75%)
Frame 91 (75%)
Frame 92 (76%)
Frame 93 (77%)
Frame 94 (78%)
Frame 95 (79%)
Frame 96 (80%)
Frame 97 (80%)
Frame 98 (81%)
Frame 99 (82%)
Frame 100 (83%)
Frame 101 (84%)
Frame 102 (85%)
Frame 103 (85%)
Frame 104 (86%)
Frame 105 (87%)
Frame 106 (88%)
Frame 107 (89%)
Frame 108 (90%)
Frame 109 (90%)
Frame 110 (91%)
Frame 111 (92%)
Frame 112 (93%)
Frame 113 (94%)
Frame 114 (95%)
Frame 115 (95%)
Frame 116 (96%)
Frame 117 (97%)
Frame 118 (98%)
Frame 119 (99%)
Frame 120 (100%)
## Finalizing encoding... done!
## [1] "data/rolling_14day_combined2_2020-10-01.gif"